home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / sbprolog / amiga / cmplibsr.zoo / $peephole1.P < prev    next >
Text File  |  1988-09-15  |  14KB  |  394 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona,1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24.  
  25. /*  "peephole_opt" is the top-level optimizer, it calls various others.      */
  26.  
  27. /* **********************************************************************
  28. $peephole1_export([$comp_peepopt/3]).
  29.  
  30. $peephole1_use($blist,[_,_,$member1/2,$not_member1/2]).
  31. ********************************************************************** */
  32.  
  33. :- mode($comp_peepopt,3,[c,d,c]).
  34.  
  35. $comp_peepopt(Pil,OptPil,Preds) :-
  36.      $comp_popt1(Pil, Pil1),
  37.      $comp_popt4(Pil1,[],_,Preds,OptPil).
  38.  
  39. :- mode($comp_popt1,2,[c,d]).
  40.  
  41. $comp_popt1([], []).
  42. $comp_popt1([Inst|Rest], Pil1) :- $comp_popt11(Inst, Rest, Pil1).
  43.  
  44. :- mode($comp_popt11,3,[c,c,d]).
  45.  
  46. $comp_popt11(puttvar(T,R), [getstr(S,R)|PRest], [putstr(S,T)|OptPRest]) :-
  47.     !,
  48.     $comp_popt1a(PRest, OptPRest).
  49. $comp_popt11(puttvar(T,R), [getlist(R)|PRest], [putlist(T)|OptPRest]) :-
  50.     !,
  51.     $comp_popt1a(PRest, OptPRest).
  52. $comp_popt11(movreg(T,R),[Inst|PRest],OptInstList) :-
  53.     !,
  54.     T =:= R ->
  55.          $comp_popt11(Inst,PRest,OptInstList) ;
  56.          $popt_movreg(Inst,R,T,PRest,OptInstList).
  57. $comp_popt11(putpvar(V,R), [getpval(V,R)|PRest], [putpvar(V,R)|OptPRest]) :-
  58.     !,
  59.     $comp_popt1(PRest, OptPRest).
  60. $comp_popt11(putpvar(V,R), [getstr(Str,R)|PRest], [putstrv(Str,V)|OptPRest]) :-
  61.     !,
  62.     $comp_popt1a(PRest, OptPRest).
  63. $comp_popt11(putpval(V,R), [getstr(Str,R)|PRest], [getstrv(Str,V)|OptPRest]) :-
  64.     !,
  65.     $comp_popt1(PRest, OptPRest).
  66. $comp_popt11(getlist(R), [unitvar(R1),unitvar(R2)|PRest],[getlist_tvar_tvar(R,R1,R2)|OptPRest]) :-
  67.     !,
  68.     $comp_popt1(PRest,OptPRest).
  69. $comp_popt11(getcomma(R), [unitvar(R1),unitvar(R2)|PRest],[getcomma_tvar_tvar(R,R1,R2)|OptPRest]) :-
  70.     !,
  71.     $comp_popt1(PRest,OptPRest).
  72. $comp_popt11(getlist_k(R), [unitvar(R1),unitvar(R2)|PRest],[getlist_k_tvar_tvar(R,R1,R2)|OptPRest]) :-
  73.     !,
  74.     $comp_popt1(PRest,OptPRest).
  75. $comp_popt11(gettval(R,R), PRest,OptPRest) :-
  76.     !,
  77.     $comp_popt1(PRest, OptPRest).
  78. $comp_popt11(unitvar(R), [movreg(R,S)|PRest], OptInstList) :-
  79.     !,
  80.     ($peep_chk(PRest,R) ->
  81.          OptInstList = [unitvar(S)|OptPRest] ;
  82.          OptInstList = [unitvar(R),movreg(R,S)|OptPRest]
  83.     ),
  84.     $comp_popt1(PRest, OptPRest).
  85. $comp_popt11(jump(L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  86.     !,
  87.     $comp_popt1(PRest,OptPRest).
  88. $comp_popt11(jump(Addr), [jump(_)|PRest],  [jump(Addr)|OptPRest]) :-
  89.     !,
  90.     $comp_popt1(PRest,OptPRest).
  91. $comp_popt11(jumpz(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  92.     !,
  93.     $comp_popt1(PRest,OptPRest).
  94. $comp_popt11(jumpnz(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  95.     !,
  96.     $comp_popt1(PRest,OptPRest).
  97. $comp_popt11(jumplt(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  98.     !,
  99.     $comp_popt1(PRest, OptPRest).
  100. $comp_popt11(jumple(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  101.     !,
  102.     $comp_popt1(PRest, OptPRest).
  103. $comp_popt11(jumpgt(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  104.     !,
  105.     $comp_popt1(PRest,OptPRest).
  106. $comp_popt11(jumpge(_,L), [label(L)|PRest],  [label(L)|OptPRest]) :-
  107.     !,
  108.     $comp_popt1(PRest,OptPRest).
  109. $comp_popt11(Inst, PRest, [Inst|OptPRest]) :- 
  110.     $comp_popt1(PRest, OptPRest).
  111.  
  112. :- mode($comp_popt1a,2,[c,d]).
  113.  
  114. $comp_popt1a([], []).
  115. $comp_popt1a([Inst|PRest], OptPList) :-
  116.      $popt_uni2bld(Inst,BldInst) ->
  117.           (OptPList = [BldInst|OptPRest],
  118.        $comp_popt1a(PRest,OptPRest)
  119.       ) ;
  120.       $comp_popt11(Inst,PRest,OptPList).
  121.  
  122. :- mode($popt_uni2bld,2,[c,d]).
  123.  
  124. $popt_uni2bld(unipvar(X), bldpvar(X)).
  125. $popt_uni2bld(unipval(X), bldpval(X)).
  126. $popt_uni2bld(unitvar(X), bldtvar(X)).
  127. $popt_uni2bld(unitval(X), bldtval(X)).
  128. $popt_uni2bld(unicon(X), bldcon(X)).
  129. $popt_uni2bld(uninil, bldnil).
  130. $popt_uni2bld(uninumcon(X), bldnumcon(X)).
  131. $popt_uni2bld(unifloatcon(X), bldfloatcon(X)).
  132.  
  133. /*      "popt4" eliminates some redundant instructions.    */
  134.  
  135.  
  136. $comp_popt4([],_,_,Preds,[]).
  137. $comp_popt4([Inst|IRest],RCont,Seen,Preds,OList) :-
  138.     ($popt_builtin(Inst,Preds,OList,ORest) ->
  139.         RCont1 = RCont ;
  140.         ($peep_redundant(Inst,IRest,RCont,RCont1,Seen,El),
  141.          (El =:= 1 -> OList = ORest ; OList = [Inst|ORest])
  142.         )
  143.     ),
  144.     $comp_popt4(IRest,RCont1,Seen,Preds,ORest).
  145.  
  146. :- mode($popt_builtin,4,[c,c,d,d]).
  147.  
  148. $popt_builtin(call((P,N),_),Preds,[builtin(Bno)|IRest],IRest) :-
  149.      $comp_builtin(P,N,Bno),
  150.      $not_member1('/'(P,N),Preds),
  151.      !.
  152. $popt_builtin(calld((P,N),_),Preds,[builtin(Bno)|IRest],IRest) :-
  153.      $comp_builtin(P,N,Bno),
  154.      $not_member1('/'(P,N),Preds),
  155.      !.
  156. $popt_builtin(execute((P,N)),Preds,[builtin(Bno),proceed|IRest],IRest) :-
  157.      $comp_builtin(P,N,Bno),
  158.      $not_member1('/'(P,N),Preds).
  159.  
  160. :- mode($popt_movreg,5,[c,c,c,c,d]).
  161.  
  162. $popt_movreg(Inst,R,T,PRest,OptInstList) :-
  163.     ( ($popt_movreg0(Inst,R,T,OptInst), $peep_chk(PRest,R))  ->
  164.          OptInstList = [OptInst|OptInstRest] ;
  165.          OptInstList = [movreg(T,R),Inst|OptInstRest]
  166.     ),
  167.     $comp_popt1(PRest, OptInstRest).
  168.  
  169. :- mode($popt_movreg0,4,[c,c,c,d]).
  170.  
  171. $popt_movreg0(getstr(S,R),R,T,getstr(S,T)).
  172. $popt_movreg0(puttbreg(R),R,T,puttbreg(T)).
  173. $popt_movreg0(addreg(R,S),R,T,addreg(T,S)).
  174. $popt_movreg0(subreg(R,S),R,T,subreg(T,S)).
  175. $popt_movreg0(mulreg(R,S),R,T,mulreg(T,S)).
  176. $popt_movreg0(divreg(R,S),R,T,divreg(T,S)).
  177. $popt_movreg0(idivreg(R,S),R,T,idivreg(T,S)).
  178. $popt_movreg0(get_tag(R,S),R,T,get_tag(T,S)).
  179. $popt_movreg0(arg(R,R2,R3),R,T,arg(T,R2,R3)).
  180. $popt_movreg0(arg(R1,R,R3),R,T,arg(R1,T,R3)).
  181. $popt_movreg0(arg(R1,R2,R),R,T,arg(R1,R2,T)).
  182. $popt_movreg0(arg0(R,R2,R3),R,T,arg0(T,R2,R3)).
  183. $popt_movreg0(arg0(R1,R,R3),R,T,arg0(R1,T,R3)).
  184. $popt_movreg0(arg0(R1,R2,R),R,T,arg0(R1,R2,T)).
  185. $popt_movreg0(test_unifiable(R,R2,R3),R,T,test_unifiable(T,R2,R3)).
  186. $popt_movreg0(test_unifiable(R1,R,R3),R,T,test_unifiable(R1,T,R3)).
  187. $popt_movreg0(test_unifiable(R1,R2,R),R,T,test_unifiable(R1,R2,T)).
  188.  
  189.  
  190. $popt_chkmember(P,L,Flag) :-
  191.     (var(L), L = [P|_], Flag = 1) ;
  192.     (nonvar(L), L = [P1|L1],
  193.      (P = P1 -> Flag = 0 ; $popt_chkmember(P,L1,Flag))
  194.     ).
  195.  
  196. /*  these instrs use the contents of a reg */
  197.  
  198. :- mode($peep_use,2,[c,d]).
  199.  
  200. $peep_use(getcon(_,R),R).
  201. $peep_use(getnumcon(_,R),R).
  202. $peep_use(getfloatcon(_,R),R).
  203. $peep_use(getpval(_,R),R).
  204. $peep_use(gettval(_,R),R).
  205. $peep_use(gettval(R,_),R).
  206. $peep_use(gettbreg(R),R).
  207. $peep_use(getpbreg(R),R).
  208. $peep_use(getstr(_,R),R).
  209. $peep_use(getstrv(_,R),R).
  210. $peep_use(getlist(R),R).
  211. $peep_use(getlist_tvar_tvar(R,_,_),R).
  212. $peep_use(getcomma(R),R).
  213. $peep_use(getcomma_tvar_tvar(R,_,_),R).
  214. $peep_use(get_tag(R,_),R).
  215. $peep_use(unitval(R),R).
  216. $peep_use(unipval(R),R).
  217. $peep_use(bldtval(R),R).
  218. $peep_use(bldpval(R),R).
  219. $peep_use(arg(R,_,_),R).
  220. $peep_use(arg(_,R,_),R).
  221. $peep_use(arg(_,_,R),R).
  222. $peep_use(arg0(R,_,_),R).
  223. $peep_use(arg0(_,R,_),R).
  224. $peep_use(arg0(_,_,R),R).
  225. $peep_use(test_unifiable(R,_,_),R).
  226. $peep_use(test_unifiable(_,R,_),R).
  227. $peep_use(and(R,_),R).
  228. $peep_use(and(_,R),R).
  229. $peep_use(negate(R),R).
  230. $peep_use(or(R,_),R).
  231. $peep_use(or(_,R),R).
  232. $peep_use(lshiftl(R,_),R).
  233. $peep_use(lshiftl(_,R),R).
  234. $peep_use(lshiftr(R,_),R).
  235. $peep_use(lshiftr(_,R),R).
  236. $peep_use(addreg(R,_),R).
  237. $peep_use(addreg(_,R),R).
  238. $peep_use(subreg(R,_),R).
  239. $peep_use(subreg(_,R),R).
  240. $peep_use(mulreg(R,_),R).
  241. $peep_use(mulreg(_,R),R).
  242. $peep_use(divreg(R,_),R).
  243. $peep_use(divreg(_,R),R).
  244. $peep_use(idivreg(R,_),R).
  245. $peep_use(idivreg(_,R),R).
  246. $peep_use(movreg(R,_),R).
  247. $peep_use(switchonterm(R,_,_),R).
  248. $peep_use(switchonlist(R,_,_),R).
  249. $peep_use(switchonbound(R,_,_),R).
  250. $peep_use(jump(_),_).        /* too lazy to chase jumps! */
  251. $peep_use(jumpeq(R,L),R) :- L \= abs(-1).
  252. $peep_use(jumpne(R,L),R) :- L \= abs(-1).
  253. $peep_use(jumplt(R,L),R) :- L \= abs(-1).
  254. $peep_use(jumple(R,L),R) :- L \= abs(-1).
  255. $peep_use(jumpgt(R,L),R) :- L \= abs(-1).
  256. $peep_use(jumpge(R,L),R) :- L \= abs(-1).
  257.  
  258. $peep_chk([],_).
  259. $peep_chk([Inst|Rest],R) :-
  260.     not($peep_use(Inst,R)), 
  261.     (($peep_term(Inst,R), !) ; $peep_chk(Rest,R)).
  262.  
  263. :- mode($peep_term,2,[c,d]).
  264.  
  265. /* these instrs change contents of reg */
  266.  
  267. $peep_term(call(_,_),_).
  268. $peep_term(calld(_,_),_).
  269. $peep_term(execute(_),_).
  270. $peep_term('_$execmarker',_).
  271. $peep_term(putcon(R),R).
  272. $peep_term(putnumcon(R),R).
  273. $peep_term(putfloatcon(R),R).
  274. $peep_term(puttvar(R,_),R).
  275. $peep_term(putpvar(_,R),R).
  276. $peep_term(putdval(_,R),R).
  277. $peep_term(putuval(_,R),R).
  278. $peep_term(puttbreg(R),R).
  279. $peep_term(putpval(_,R),R).
  280. $peep_term(putstr(_,R),R).
  281. $peep_term(putstrv(_,R),R).
  282. $peep_term(putlist(R),R).
  283. $peep_term(putnil(R),R).
  284. $peep_term(get_tag(_,R),R).
  285. $peep_term(movreg(_,R),R).
  286. $peep_term(bldtvar(R),R).
  287. $peep_term(test_unifiable(_,_,R),R).
  288.  
  289. $peep_redundant('_$execmarker',_,R,R,_,1).
  290. $peep_redundant(Inst,IRest,RCont,RCont1,Seen,El) :-
  291.     $peep_elim(Inst,IRest,RCont,RCont1,Seen,El) ->
  292.         true ;
  293.         (RCont1 = RCont, El = 0).
  294.  
  295. :- mode($peep_elim,6,[c,c,d,d,d,d]).
  296.  
  297. $peep_elim(getpvar(V,R),_,RCont,[r(R,v(V))|RCont],_,0).
  298. $peep_elim(getpval(V,R),_,RCont,RCont1,Seen,El) :-
  299.     $member1(r(R,v(V)),RCont) ->
  300.         (El = 1, RCont1 = Rcont) ;
  301.         (El = 0, RCont1 = [r(R,v(V))|RCont]).
  302. $peep_elim(getcon(C,R),_,RCont,RCont1,Seen,El) :-
  303.     $member1(r(R,c(C)),RCont) ->
  304.         (El = 1, RCont1 = Rcont) ;
  305.         (El = 0, RCont1 = [r(R,c(C))|RCont]).
  306. $peep_elim(getnumcon(N,R),_,RCont,RCont1,Seen,El) :-
  307.     $member1(r(R,n(N)),RCont) ->
  308.         (El = 1, RCont1 = Rcont) ;
  309.         (El = 0, RCont1 = [r(R,n(N))|RCont]).
  310. $peep_elim(getfloatcon(N,R),_,RCont,RCont1,Seen,El) :-
  311.     $member1(r(R,nf(N)),RCont) ->
  312.         (El = 1, RCont1 = Rcont) ;
  313.         (El = 0, RCont1 = [r(R,nf(N))|RCont]).
  314. $peep_elim(getnil(R),_,RCont,RCont1,Seen,El) :-
  315.     $member1(r(R,c(nil)),RCont) ->
  316.         (El = 1, RCont1 = Rcont) ;
  317.         (El = 0, RCont1 = [r(R,c(nil))|RCont]).
  318. $peep_elim(putpvar(V,R),_,L0,L1,_,0) :- $peep_elim_upd(L0,R,v(V),L1).
  319. $peep_elim(putpval(V,R),_,RCont,RCont1,_,El) :-
  320.     $member1(r(R,v(V)),RCont) ->
  321.         (El = 1, RCont1 = RCont) ;
  322.         (El = 0, $peep_elim_upd(RCont,R,v(V),RCont1)).
  323. $peep_elim(puttvar(R,R1),_,L0,L1,_,0) :-
  324.     $peep_del(L0,r(R,_),L2), $peep_del(L2,r(R1,_),L1).
  325. $peep_elim(putcon(C,R),_,RCont,RCont1,_,El) :-
  326.     $member1(r(R,c(C)),RCont) ->
  327.         (El = 1, RCont1 = RCont) ;
  328.         (El = 0, $peep_elim_upd(RCont,R,c(C),RCont1)).
  329. $peep_elim(putnumcon(N,R),_,RCont,RCont1,_,El) :-
  330.     $member1(r(R,n(N)),RCont) ->
  331.         (El = 1, RCont1 = RCont);
  332.         (El = 0, $peep_elim_upd(RCont,R,n(N),RCont1)).
  333. $peep_elim(putfloatcon(N,R),_,RCont,RCont1,_,El) :-
  334.     $member1(r(R,nf(N)),RCont) ->
  335.         (El = 1, RCont1 = RCont) ;
  336.         (El = 0, $peep_elim_upd(RCont,R,nf(N),RCont1)).
  337. $peep_elim(putnil(R),_,RCont,RCont1,_,El) :-
  338.     $member1(r(R,c(nil)),RCont) ->
  339.         (El = 1, RCont1 = RCont);
  340.         (El = 0, $peep_elim_upd(RCont,R,c(nil),RCont1)).
  341. $peep_elim(putstr(F,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  342. $peep_elim(putlist(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  343. $peep_elim(and(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  344. $peep_elim(or(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  345. $peep_elim(negate(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  346. $peep_elim(lshiftr(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  347. $peep_elim(lshiftl(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  348. $peep_elim(addreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  349. $peep_elim(subreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  350. $peep_elim(mulreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  351. $peep_elim(divreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  352. $peep_elim(idivreg(_,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  353. $peep_elim(movreg(R,R1),_,L0,L1,_,0) :- $peep_elim_upd(L0,R1,r(R),L1).
  354. $peep_elim(gettbreg(R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  355. $peep_elim(putdval(V,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  356. $peep_elim(putuval(V,R),_,L0,L1,_,0) :- $peep_del(L0,r(R,_),L1).
  357. $peep_elim(label((P,N,K)),_,_,[],Seen,0) :-
  358.     N >= 0 -> $member1((P,N),Seen) ; true.
  359. $peep_elim(call(_,_),_,_,[],_,0).
  360. $peep_elim(proceed,_,_,[],_,0).
  361. $peep_elim(execute((P,N)),IRest,_,[],Seen,El) :-
  362.     (IRest = [label((P,N,K))|_], N >= 0) ->
  363.         $popt_chkmember((P,N),Seen,El) ;
  364.         El = 0.
  365. $peep_elim(calld(_,_),_,_,[],_,0).
  366. $peep_elim(builtin(_),_,_,[],_,0).
  367. $peep_elim(trymeelse(_,_),_,_,[],_,0).
  368. $peep_elim(retrymeelse(_,_),_,_,[],_,0).
  369. $peep_elim(trustmeelsefail(_),_,_,[],_,0).
  370. $peep_elim(try(_,_),_,_,[],_,0).
  371. $peep_elim(retry(_,_),_,_,[],_,0).
  372. $peep_elim(trust(_),_,_,[],_,0).
  373. $peep_elim(jump(_),_,_,[],_,0).
  374. $peep_elim(jumpz(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  375. $peep_elim(jumpnz(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  376. $peep_elim(jumplt(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  377. $peep_elim(jumple(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  378. $peep_elim(jumpgt(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  379. $peep_elim(jumpge(_,L),_,R0,R1,_,0) :- L ?= abs(-1) -> R1 = R0 ; R1 = [].
  380. $peep_elim(switchonterm(_,_,_),_,_,[],_,0).
  381. $peep_elim(switchonlist(_,_,_),_,_,[],_,0).
  382. $peep_elim(switchonbound(_,_,_),_,_,[],_,0).
  383.  
  384. $peep_del([],_,[]).
  385. $peep_del([X|L],Y,L1) :- 
  386.     (X ?= Y -> L1 = L1Rest ; L1 = [X|L1Rest]),
  387.     $peep_del(L,Y,L1Rest).
  388.  
  389. $peep_elim_upd(L0,R,Cont,[r(R,Cont)|L1]) :- $peep_del(L0,r(R,_),L1).
  390.  
  391. /* ------------------------------ peephole.P ------------------------------ */
  392.  
  393.  
  394.